home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / utility.com / UTILITY.DOC < prev    next >
Encoding:
Text File  |  1989-09-12  |  34.8 KB  |  701 lines
  1. {
  2. ╒════════════════════════════════════════════════════════════════════════╕
  3. │                                                                        │
  4. │          This UNIT was written for TURBO PASCAL 5.0 by:                │
  5. │                                                                        │
  6. │                      GEMINI SYSTEMS                                    │
  7. │                      P.O. BOX 7086                                     │
  8. │                      BLOOMFIELD HILLS, MI  48302                       │
  9. │                                                                        │
  10. │                                                                        │
  11. │                                                                        │
  12. │  To use in your programs, simply state UTILITY in your uses clause.    │
  13. │                                                                        │
  14. │  example:      PROGRAM prog_name;                                      │
  15. │                  USES utility;       (Programs must be compiled with   │
  16. │                                       the $V- Compiler Directive)      │
  17. ├────────────────────────────────────────────────────────────────────────┤
  18. │ Modification History:                                                  │
  19. │                                                                        │
  20. │      Version Number    Date             Change Made                    │
  21. │  ───────────────────────────────────────────────────────────────────── │
  22. │          7.5         03/21/89         Does not Change Textmode         │
  23. │          7.6         06/12/89         Add ENCRYPT, CENTER              │
  24. │          7.7         08/15/89         Restore FILEMODE in the          │
  25. │                                       GET_FILE_NAME routine.           │
  26. │          7.8         09/01/89         Fix bug in READ_REAL             │
  27. │          7.9         09/07/89         Change READSTR to allow          │
  28. │                                       positioning cursor at end of     │
  29. │                                       input field.  (for READSTR_BIG)  │
  30. │          8.0         09/11/89         Added the following routines:    │
  31. │                                         SET_ATTR_BOX                   │
  32. │                                         FILE_OPEN                      │
  33. │                                         WRITE_X80_Y25;                 │
  34. │                                         RANDUM_NUMBER                  │
  35. │                                         FILE_EXIST                     │
  36. │                                         BEEP                           │
  37. │                                         READSTR_BIG                    │
  38. │                                                                        │
  39. ╘════════════════════════════════════════════════════════════════════════╛
  40. }
  41. UNIT UTILITY;
  42.  
  43. INTERFACE
  44.   USES CRT, DOS, PRINTER;
  45.  
  46. CONST
  47.   VERSION : STRING[15] = 'UTIL 8.0';   { Reset in Application if Desired   }
  48.                                        { Example:    VERSION := 'V1.0';    }
  49.   FUNC1    = #127;
  50.   FUNC2    = #128;
  51.   FUNC3    = #129;
  52.   FUNC4    = #130;
  53.   FUNC5    = #131;
  54.   FUNC6    = #132;
  55.   FUNC7    = #133;
  56.   FUNC8    = #134;
  57.   FUNC9    = #135;
  58.   FUNC10   = #136;
  59.   AF1      = #139;
  60.   AF2      = #140;
  61.   AF3      = #141;
  62.   AF4      = #142;
  63.   AF5      = #143;
  64.   AF6      = #144;
  65.   AF7      = #145;
  66.   AF8      = #146;
  67.   AF9      = #147;
  68.   AF10     = #148;
  69.   ALT_A    = #151;
  70.   ALT_B    = #152;
  71.   ALT_C    = #153;
  72.   ALT_D    = #154;
  73.   ALT_E    = #155;
  74.   ALT_F    = #156;
  75.   ALT_G    = #157;
  76.   ALT_H    = #158;
  77.   ALT_I    = #159;
  78.   ALT_J    = #160;
  79.   ALT_K    = #161;
  80.   ALT_L    = #162;
  81.   ALT_M    = #163;
  82.   ALT_N    = #164;
  83.   ALT_O    = #165;
  84.   ALT_P    = #166;
  85.   ALT_Q    = #167;
  86.   ALT_R    = #168;
  87.   ALT_S    = #169;
  88.   ALT_T    = #170;
  89.   ALT_U    = #171;
  90.   ALT_V    = #172;
  91.   ALT_W    = #173;
  92.   ALT_X    = #174;
  93.   ALT_Y    = #175;
  94.   ALT_Z    = #176;
  95.   CF1      = #177;
  96.   PGUP     = #178;
  97.   PGDN     = #179;
  98.   UP       = #180;
  99.   DOWN     = #181;
  100.   LEFT     = #191;
  101.   RIGHT    = #192;
  102.   BACKUP   = #194;
  103.   HOMEKEY  = #196;
  104.   ENDKEY   = #197;
  105.   INSKEY   = #198;
  106.   DELKEY   = #199;
  107.   BACKSPACE= #8;
  108.   TAB      = #9;
  109.   ENTER    = #13;
  110.   RETURN   = #13;
  111.   ESCAPE   = #27;
  112.  
  113. TYPE
  114.   STR3     = STRING [3];
  115.   STR8     = STRING [8];
  116.   STR20    = STRING [20];
  117.   STR80    = STRING [80];
  118.   BUFFER   = ARRAY [1..4000] OF CHAR;  { Use for calls to SAVE_SCREEN      }
  119.   LINE_SET = SET OF 1..80;             { Use for calls to SET_ATTR         }
  120.   CURTYPE  = (BLOCK,                   { Use for calls to SET_CURSOR       }
  121.               UNDERLINE,
  122.               NONE,
  123.               HALF);
  124.   ETYPE    = SET OF CHAR;
  125.   CTYPE    = SET OF 1..80;
  126.   TYPEN    = (RNUM,LNUM,INUM);
  127.  
  128. VAR
  129.   CH         : CHAR;                { Global CHAR Variable              }
  130.   NOCONV     : CHAR;                { If included in EXITCH to READSTR  }
  131.                                     { LEFT or RIGHT is not converted to }
  132.                                     { UP or DOWN if in first or last
  133.                                     { position.                         }
  134.   CLEAR      : CHAR;                { If included in EXITCH to READSTR  }
  135.                                     { the value being edited is set to  }
  136.                                     { spaces.                           }
  137.   CGA_PRESENT: BOOLEAN;             { Is TRUE if CGA-ABILITY is Present }
  138.   EGA_PRESENT: BOOLEAN;             { Is TRUE if EGA-ABILITY is Present }
  139.  
  140.   DOS_VER    : STR3;                { Contains DOS Version at Startup   }
  141.                                     { i.e.  "3.3"                       }
  142.  
  143.   TIME       : STR8;                { Is set to Current Time at Startup }
  144.   DATE       : STR20;               { Is set to Current Date at Startup }
  145.  
  146.                                     { Date & Time are updated when any  }
  147.                                     { of the following routines are     }
  148.                                     { called:                           }
  149.                                     {     READSTR     Updates Time      }
  150.                                     {     READ_REAL   Updates Time      }
  151.                                     {     READ_INT    Updates Time      }
  152.                                     {     READCHTIME  Updates Time      }
  153.                                     {     WRITE_TIME  Updates Time      }
  154.                                     {     WRITE_DATE  Updates Date      }
  155.                                     {     READCHT     Updates Time      }
  156.  
  157.   TIM        : LONGINT;             { Is used with START_TIMER at Entry }
  158.                                     { or can be used for any Timer      }
  159.  
  160.   P          : ^BUFFER;             { Pointer to Video Memory           }
  161.   CUR        : CURTYPE;             { Stores the Current Cursor Shape   }
  162.   DISPLAY    : CHAR;
  163.   NUM_INPUTS : INTEGER;
  164.   ENTER_KEY  : STRING[3];           { Contains the Symbol for Enter Key   }
  165.  
  166.   CHANGED    : BOOLEAN;             { Set to TRUE or FALSE after each     }
  167.                                     { call to:
  168.                                               READSTR
  169.                                               READ_REAL
  170.                                               READ_INT
  171.                                       depending if that value has changed.}
  172.  
  173. (*════════════════════════════════════════════════════════════════════════*)
  174. PROCEDURE BEEP;
  175.  
  176. (*                                     Nicer than CHR(7).                 *)
  177. (*════════════════════════════════════════════════════════════════════════*)
  178. PROCEDURE BIN_LED(L : BYTE);
  179.  
  180. {   USES KEYBOARD LED'S TO TURN ON A BINARY NUMBER FROM 0 TO 7            }
  181. {                                                                         }
  182. {   BIN_LED(5)                        Used for Debugging,                 }
  183. {                                     0 Turns OFF CAPS, SCROLL, NUM       }
  184. {                                     1 Turns ON SCROLL, OFF CAPS, NUM    }
  185. {                                     2 Turns ON NUM, OFF CAPS, SCROLL    }
  186. {     BINARY VALUE                    3 Turns ON SCROLL, NUM OFF CAPS     }
  187. {  CAPS   NUM   SCROLL                4 Turns ON CAPS, OFF SCROLL, NUM    }
  188. {                                     5 Turns ON CAPS, SCROLL, OFF NUM    }
  189. {    4     2       1                  6 Turns ON CAPS, NUM, OFF SCROLL    }
  190. {                                     7 Turns ON CAPS, NUM, SCROLL        }
  191. (*════════════════════════════════════════════════════════════════════════*)
  192. FUNCTION CAPS_ARE_ON : BOOLEAN;
  193.  
  194. {           Returns TRUE if CAPS LOCK is ON.                  }
  195. (*════════════════════════════════════════════════════════════════════════*)
  196. PROCEDURE CAPS_OFF;
  197.  
  198. {           Turns CAPS LOCK KEY off.                          }
  199. (*════════════════════════════════════════════════════════════════════════*)
  200. PROCEDURE CAPS_ON;
  201.  
  202. {           Turns CAPS LOCK KEY on.                           }
  203. (*════════════════════════════════════════════════════════════════════════*)
  204. PROCEDURE CENTER(Y, ATTRIB : INTEGER; LINE : STRING);
  205.  
  206. {                                     CENTERS LINE ON STRING ON LINE Y    }
  207. {                                     USING ATTRIB FOR COLORS.            }
  208. (*════════════════════════════════════════════════════════════════════════*)
  209. PROCEDURE CENTER_PRINT(LINE     : STRING;
  210.                         LEN     : INTEGER;
  211.                     VAR NEXTPOS : INTEGER;
  212.                         CR      : BOOLEAN);
  213.  
  214. {                                     Prints LINE on Printer Centered on  }
  215. {                                     a line LEN characters long.         }
  216. {                                     NEXTPOS returns the cursor position }
  217. {                                     off the print head. Set CR to True  }
  218. {                                     to issue a WRITELN or False to issue}
  219. {                                     a WRITE.                            }
  220. (*════════════════════════════════════════════════════════════════════════*)
  221. FUNCTION CHECK_KEYBOARD : CHAR;
  222.  
  223. {                                     If a key was pressed returns the    }
  224. {                                     character entered, else returns     }
  225. {                                     character #0.                       }
  226. (*════════════════════════════════════════════════════════════════════════*)
  227. FUNCTION COMBINE(S1, S2 : STRING;
  228.                     MAX : INTEGER;
  229.            INSERT_COMMA : BOOLEAN) : STRING;
  230. {                                                                         }
  231. {    S1 := 'Tom         ';                                                }
  232. {    S2 := 'Hunter      ';                                                }
  233. {    WRITELN(COMBINE(S2,S1,20,TRUE));                                     }
  234. {                                                                         }
  235. {      Result:                         Combines the two variables S1 & S2 }
  236. {         Hunter, Tom                  removing trailing blanks from S1.  }
  237. {                                      If passed TRUE it will insert a    }
  238. {                                      comma between the two variables.   }
  239.  
  240. (*════════════════════════════════════════════════════════════════════════*)
  241. FUNCTION  COMMA(VAR VALUE; FIELDWIDTH,
  242.                                 PLACES : INTEGER;
  243.                                  NTYPE : TYPEN) : STRING;
  244.  
  245.  
  246. {        WRITE(COMMA(R,I,J,RNUM));       Will take the real value  }
  247. {                                        R and return a string I   }
  248. {        R := 1234567.89                 characters long with J    }
  249. {        WRITE(COMMA(R,12,2,RNUM));      decimal places.           }
  250. {                                                                  }
  251. {          Result:                                                 }
  252. {            1,234,567.89                RNUM for REAL Numbers     }
  253. {                                        INUM for INTEGER Numbers  }
  254. {                                        LNUM for LONGINT Numbers  }
  255. {                                                                  }
  256. (*════════════════════════════════════════════════════════════════════════*)
  257. PROCEDURE DOWN_SOUND;
  258.  
  259. {           Makes a Sound of Decreasing Pitch.                }
  260. (*════════════════════════════════════════════════════════════════════════*)
  261. FUNCTION DRIVE_READY(DRIVE : CHAR) : BOOLEAN;
  262.  
  263. {    IF DRIVE_READY('A') THEN         Returns TRUE if drive is ready.     }
  264. {      ASSIGN(F,'A:TEST.DTA');                                            }
  265. {                                                                         }
  266. (*════════════════════════════════════════════════════════════════════════*)
  267. FUNCTION  ELAP_TIME(T : LONGINT) : LONGINT;
  268.  
  269. {           ELAP_TIME(TIM);           Will Return the number of seconds }
  270. {                                     that have elapsed since the last  }
  271. {                                     call to START_TIMER with TIM, or  }
  272. {                                     any other LONGINT variable.       }
  273. (*════════════════════════════════════════════════════════════════════════*)
  274. PROCEDURE ENCRYPT(VAR LINE : STRING; I : INTEGER);
  275.  
  276. {                                     ENCRYPTS A STRING USING I AS KEY.    }
  277. (*════════════════════════════════════════════════════════════════════════*)
  278. FUNCTION FILE_EXIST(FILENAME : STRING) : BOOLEAN;
  279.  
  280. (*                                     Returns True if File exists or
  281.                                        false if it does not.              *)
  282. (*════════════════════════════════════════════════════════════════════════*)
  283. FUNCTION FILE_OPEN(VAR F) : BOOLEAN;
  284.  
  285. (*                                     Returns True if File F is Open or
  286.                                        returns False if it is closed.     *)
  287. (*════════════════════════════════════════════════════════════════════════*)
  288. PROCEDURE FW(X,Y : INTEGER; ATTR : BYTE; LINE : STR80);
  289.  
  290. {        FW(X,Y,$07,S);               Writes the value of string  }
  291. {          or                         S at X,Y with 0 Background  }
  292. {        FW(X,Y,$01,S1+S2+'X');       color and 7 Foreground.     }
  293. {                                     This Procedure Supports     }
  294. {                                     43 line mode. (1 >= Y <= 43 }
  295. (*════════════════════════════════════════════════════════════════════════*)
  296. FUNCTION GET_FILE_NAME(MASK : STRING; DEL : BOOLEAN) : STRING;
  297.  
  298. {   INSTRING := GET_FILE_NAME('*.*',TRUE);
  299.  
  300. {                                     Returns a selected filename         }
  301. {                                     and allows deletions if TRUE.       }
  302. (*════════════════════════════════════════════════════════════════════════*)
  303. PROCEDURE GOTOXY43(X,Y : INTEGER);
  304.  
  305. {           GOTOXY43(10,43);          This will move the cursor to    }
  306. {                                     10,43 if 43 line mode is active }
  307. (*════════════════════════════════════════════════════════════════════════*)
  308. PROCEDURE LINES25;
  309.  
  310. {                                     After a call to LINES43, this   }
  311. {                                     will return you to 25 line mode.}
  312. (*════════════════════════════════════════════════════════════════════════*)
  313. PROCEDURE LINES43;
  314.  
  315. {                                     If EGA card is present this     }
  316. {                                     will put you in 43 line mode.   }
  317. (*════════════════════════════════════════════════════════════════════════*)
  318. FUNCTION NUM_LOCK_IS_ON : BOOLEAN;
  319.  
  320. {           Returns TRUE if NUM-LOCK is ON.                   }
  321. (*════════════════════════════════════════════════════════════════════════*)
  322. PROCEDURE NUM_LOCK_OFF;
  323.  
  324. {           Turns NUM LOCK KEY off.                           }
  325. (*════════════════════════════════════════════════════════════════════════*)
  326. PROCEDURE NUM_LOCK_ON;
  327.  
  328. {           Turns NUM LOCK KEY on.                            }
  329. (*════════════════════════════════════════════════════════════════════════*)
  330. FUNCTION  PAD(VAR S : STRING; LEN : INTEGER) : STRING;
  331.  
  332. {          PAD(S,20);                 Will PAD String variable S to be  }
  333. {                                     20 characters long.               }
  334. (*════════════════════════════════════════════════════════════════════════*)
  335.  
  336. PROCEDURE PATHEXEC(COMMAND : PATHSTR; PARMS : STRING);
  337.  
  338. {                                     Like Turbo Pascal's EXEC, except    }
  339. {                                     Searches the DOS path.              }
  340. {                                     Do not call SwapVectors before and  }
  341. {                                     after this routine.                 }
  342. (*════════════════════════════════════════════════════════════════════════*)
  343. PROCEDURE PRINT_SCREEN(X1,Y1,X2,Y2 : INTEGER; EXT : BOOLEAN);
  344.  
  345. {                                                                         }
  346. {    PRINT_SCREEN(1,1,80,25,TRUE);    Prints a section of the screen,     }
  347. {                                     bounded by the coordinates.  The    }
  348. {                                     screen coordinates are the same as  }
  349. {                                     Turbo Pascal's WINDOW procedure.    }
  350. {                                     To print IBM Extended Graphic       }
  351. {                                     characters use TRUE.  FALSE will    }
  352. {                                     print spaces instead of graphics.   }
  353. {                                     The above example would print the   }
  354. {                                     entire screen.                      }
  355. (*════════════════════════════════════════════════════════════════════════*)
  356. FUNCTION  PRINTER_NOT_READY : BOOLEAN;
  357.  
  358. {           Returns TRUE if the Line Printer is not ready.    }
  359. (*════════════════════════════════════════════════════════════════════════*)
  360. FUNCTION PRINTER_READY : BOOLEAN;
  361. {                                                                         }
  362. {    IF PRINTER_READY THEN            If Printer is NOT READY, pops up    }
  363. {      WRITELN(LST,'HELLO WORLD');    a Window, asking for you to ready   }
  364. {                                     it.  Pressing <ESC> returns FALSE.  }
  365. {                                     Turning Print ON, (or if it was     }
  366. {                                     already on) returns TRUE.           }
  367. (*════════════════════════════════════════════════════════════════════════*)
  368. FUNCTION RANDOM_NUMBER(LOW, HIGH : INTEGER) : INTEGER;
  369.  
  370. (*                                     Produces a Random number between
  371.                                        0 and 99.  if LOW is less than 0
  372.                                        or HIGH is greater than 99 will
  373.                                        always return 0.  Do not call this
  374.                                        routine from a loop.  It uses 1/100
  375.                                        of a second from the system clock
  376.                                        to generate the numbers.  If called
  377.                                        from within a loop it will return
  378.                                        a sequence or pattern to its numbers.
  379.                                        Works fine for a ocassional Random
  380.                                        Number.                            *)
  381. (*════════════════════════════════════════════════════════════════════════*)
  382. PROCEDURE READCH(VAR CH : CHAR; ECHO : BOOLEAN);
  383.  
  384. {       READCH(CH,TRUE);          TRUE  for echo on screen.   }
  385. {                                 FALSE for no echo.          }
  386. {                                 If ALT-F10 is pressed it    }
  387. {                                 will call SHOW_VERSION.     }
  388. {          also converts F-KEYS to FUNC1..FUNC10, HOMEKEY,    }
  389. {          UP, DOWN, LEFT, RIGHT, ECT.                        }
  390. {                                                             }
  391. {          READCH(CH,TRUE);                                   }
  392. {          IF CH = FUNC1 THEN CALL_HELP;                      }
  393. (*════════════════════════════════════════════════════════════════════════*)
  394. PROCEDURE READCHT(VAR CH : CHAR; ECHO : BOOLEAN; TOO : LONGINT);
  395.  
  396. {   Waits TOO seconds for a key to be pressed, IF no key is pressed       }
  397. {   within TOO seconds, Routine is exited leaving CH unchanged.           }
  398. {                                                                         }
  399. {   READCHT(CH,FALSE,10);             Waits 10 seconds for a key to be    }
  400. {                                     pressed, If not CH is unchanged.    }
  401. (*════════════════════════════════════════════════════════════════════════*)
  402. PROCEDURE READCHTIME(VAR CH : CHAR; ECHO : BOOLEAN; X,Y : INTEGER);
  403.  
  404. {                                     Continually Updates TIME at X,Y }
  405. {                                     until a key is pressed.  That   }
  406. {                                     key is returned in CH.          }
  407. {                                     If CH = 'M' Time will be in     }
  408. {                                     Military Time Format.           }
  409. (*════════════════════════════════════════════════════════════════════════*)
  410. PROCEDURE READ_INT(X,Y,LEN   : INTEGER;
  411.                     PATTR    : INTEGER;
  412.                     PROMPT   : STR80;
  413.                     IATTR    : INTEGER;
  414.                     VAR R    : INTEGER;
  415.                     LOW,HIGH : INTEGER;
  416.                     EXITCH   : ETYPE;
  417.                     ICOMA    : BOOLEAN;
  418.                     TX, TY   : INTEGER;
  419.                     CH       : CHAR);
  420. (*
  421.  
  422.   WHERE         X  = X Location of where Prompt will start.
  423.                 Y  = Y Location of where Prompt will start.
  424.               LEN  = Maximum Length of Field to be input.
  425.             PATTR  = Color attributes of Prompt.
  426.            PROMPT  = Prompt that will appear AT X,Y
  427.             IATTR  = Color attributes of Input Field.
  428.                 R  = Variable Parameter being Edited.
  429.               LOW  = Lowest Value Allowed.
  430.              HIGH  = Highest Value Allowed.
  431.            EXITCH  = Characters Entered From Keyboard used to Exit Edit.
  432.             ICOMA  = True for comma insertion, false for no comma.
  433.               TX,
  434.               TY   = Location on screen to update time (TX = 0 for
  435.                      no time)
  436.               CH   = 'M' for Military Time, else AM/PM
  437.  
  438.                   If NOCONV is included in EXITCH then
  439.                   LEFT or RIGHT is not converted to
  440.                   UP or DOWN if in first or last
  441.                   position.
  442.  
  443.                   If CLEAR is included in EXITCH then
  444.                   the value being edited is set to
  445.                   spaces.
  446.  
  447. *)
  448. (*════════════════════════════════════════════════════════════════════════*)
  449. PROCEDURE READ_ONLY(NAME : STRING);
  450.  
  451. {                                     Sets Filename "NAME" to READ-ONLY.}
  452. (*════════════════════════════════════════════════════════════════════════*)
  453. PROCEDURE READ_REAL(X,Y,LEN  : INTEGER;
  454.                     PATTR    : INTEGER;
  455.                     PROMPT   : STR80;
  456.                     IATTR    : INTEGER;
  457.                     VAR R    : REAL;
  458.                     DPLACES  : INTEGER;
  459.                     LOW,HIGH : REAL;
  460.                     EXITCH   : ETYPE;
  461.                     ICOMA    : BOOLEAN;
  462.                     TX, TY   : INTEGER;
  463.                     CH       : CHAR);
  464. (*
  465.  
  466.   WHERE         X  = X Location of where Prompt will start.
  467.                 Y  = Y Location of where Prompt will start.
  468.               LEN  = Length of Field to be Input.
  469.             PATTR  = Color Attributes of Prompt.
  470.            PROMPT  = Prompt that will appear at X,Y
  471.             IATTR  = Color Attributes of Input Field.
  472.                 R  = Variable Parameter being Edited.
  473.           DPLACES  = Number of Decimal Places.
  474.               LOW  = Lowest Value Allowed.
  475.              HIGH  = Highest Value Allowed.
  476.            EXITCH  = Characters Entered From Keyboard Used to Exit Edit.
  477.             ICOMA  = True for Comma Insertion, False for no commas.
  478.               TX,
  479.               TY   = Location on Screen to Update Time (TX = 0 for
  480.                      no Time.)
  481.               CH   = 'M' for Military Time, else AM/PM
  482.  
  483.                   If NOCONV is included in EXITCH then
  484.                   LEFT or RIGHT is not converted to
  485.                   UP or DOWN if in first or last
  486.                   position.
  487.  
  488.                   If CLEAR is included in EXITCH then
  489.                   the value being edited is set to
  490.                   spaces.
  491. *)
  492. (*════════════════════════════════════════════════════════════════════════*)
  493. FUNCTION READ_SCREEN(X,Y : INTEGER) : CHAR;
  494.  
  495. {   CH := READ_SCREEN(10,15);                                             }
  496. {                                     Returns the character on the screen }
  497. {                                     at X,Y. (at 10,15 in this case)     }
  498. (*════════════════════════════════════════════════════════════════════════*)
  499. PROCEDURE READSTR(X,Y,LEN : INTEGER;
  500.                     PATTR : INTEGER;
  501.                    PROMPT : STR80;
  502.                     IATTR : INTEGER;
  503.              VAR INSTRING : STR80;
  504.                     VALID : ETYPE;
  505.                   CANEDIT : CTYPE;
  506.                    EXITCH : ETYPE;
  507.                    XLOC,
  508.                    YLOC   : INTEGER;
  509.                    CH1    : CHAR);
  510. (*
  511.  
  512.   WHERE         X  = X Location of Where Prompt will start.
  513.                 Y  = Y Location of Where Prompt will start.
  514.               LEN  = Maximum Length of Input Field.
  515.             PATTR  = Color Attributes of Prompt.
  516.            PROMPT  = Prompt that will appear at X,Y.
  517.             IATTR  = Color Attributes of Input Field.
  518.          INSTRING  = Variable Parameter being Edited.
  519.             VALID  = Valid Characters that can be entered for Field.
  520.           CANEDIT  = Which Positions of Field that can be edited.
  521.            EXITCH  = Characters Entered from Keyboard Used to Exit Edit.
  522.             XLOC,
  523.             YLOC   = Location on screen to Update Time (XLOC = 0 for
  524.                      no time.) Add 100 to XLOC to initialize the
  525.                      cursor at the end of the input field instead of at
  526.                      the beginning.
  527.                      (Add 100 to YLOC for Auto Capitilization of Words)
  528.                      (Add 200 to YLOC for Auto Caps of all characters )
  529.              CH1   = 'M' for Military Time, else AM/PM
  530.  
  531.  
  532.       If you are in the first position of a field and press the RIGHT
  533.       ARROW, CH is converted to UP. If you are in the last position of
  534.       a field and press RIGHT ARROW, CH is converted to DOWN.
  535.  
  536.         UNLESS: If you include NOCONV in your EXITCH, conversion does
  537.         not take place.  If you are in the first postion of a field,
  538.         pressing LEFT ARROW will cause you to exit and leave the value
  539.         of CH set to LEFT.  If you are in the last position of a field
  540.         pressing RIGHT ARROW will cause you to exit and leave the value
  541.         CH set to RIGHT.
  542.  
  543.         If CLEAR is included in EXITCH then the value being edited is
  544.         set to spaces.
  545.  
  546. *)
  547. (*════════════════════════════════════════════════════════════════════════*)
  548. PROCEDURE READSTR_BIG(X,Y,LEN : INTEGER;
  549.                         PATTR : INTEGER;
  550.                        PROMPT : STR80;
  551.                         IATTR : INTEGER;
  552.                  VAR INSTRING : STRING;
  553.                         VALID : ETYPE;
  554.                       CANEDIT : CTYPE;
  555.                        EXITCH : ETYPE;
  556.                        XLOC,
  557.                        YLOC   : INTEGER;
  558.                        CH1    : CHAR;
  559.                        WIN    : INTEGER);
  560.  
  561. (*                                     Scrolling string Input.            *)
  562. (*                                     All parameters are the same as     *)
  563. (*                                     READSTR except the addition of WIN.*)
  564. (*                                     WIN is the size of the input field *)
  565. (*                                     for this input, LEN is the total   *)
  566. (*                                     possible length of INSTRING.       *)
  567. (*════════════════════════════════════════════════════════════════════════*)
  568. (*════════════════════════════════════════════════════════════════════════*)
  569. PROCEDURE READ_WRITE(NAME : STRING);
  570.  
  571. {                                     Sets Filename "NAME" to READ-WRITE.}
  572. (*════════════════════════════════════════════════════════════════════════*)
  573. PROCEDURE REBUILD_SCREEN(VAR SCREEN : BUFFER);
  574.  
  575. {    SEE SAVE_SCREEN ABOVE                                    }
  576. {                                                             }
  577. {   CAUTION ! In 43 Line Mode, Will only Restore top 25 lines.}
  578. (*════════════════════════════════════════════════════════════════════════*)
  579. PROCEDURE SAVE_SCREEN(VAR SCREEN : BUFFER);
  580.  
  581. {    DEFINE A VARIABLE:                                       }
  582. {         VAR                                                 }
  583. {           S : BUFFER;                                       }
  584. {                                                             }
  585. {          SAVE_SCREEN(S);       Saves Current Screen in S.   }
  586. {          REBUILD_SCREEN(S);    Restores Screen to S.        }
  587. {                                                             }
  588. {   CAUTION ! IN 43 LINE MODE, WILL ONLY SAVE TOP 25 LINES    }
  589. (*════════════════════════════════════════════════════════════════════════*)
  590. FUNCTION SCREEN_ATTR(X,Y : INTEGER) : BYTE;
  591.  
  592. {   TEXTATTR := SCREEN_ATTR(10,20);                                       }
  593. {                                     Returns the Screen Color at X,Y.    }
  594. (*════════════════════════════════════════════════════════════════════════*)
  595. PROCEDURE SET_ATTR(X : LINE_SET; Y : INTEGER;ATTRIB : BYTE);
  596.  
  597. {           SET_ATTR([1..4,10],Y,$07);                        }
  598.  
  599. {           Sets the Columns 1 thru 4 and 10 on line Y        }
  600. {           to  Background Color 0 (BLACK)                    }
  601. {           and Foreground COLOR 7 (LIGHTGRAY)                }
  602. {   CAUTION ! Use this only above line 26 if in 43 line mode. }
  603. (*════════════════════════════════════════════════════════════════════════*)
  604. PROCEDURE SET_ATTR_BOX(X1,Y1,X2,Y2,ATT : INTEGER);
  605.  
  606. (*                                     Sets Screen Attributes of the box
  607.                                        X1,Y1,X2,Y2 to the Colors of ATT.
  608.                                        Coordinates are the same as Turbo
  609.                                        Pascals Window Procedure.          *)
  610. (*════════════════════════════════════════════════════════════════════════*)
  611. PROCEDURE SET_CURSOR(CURS : CURTYPE);
  612.  
  613. {    SET_CURSOR(NONE);          Makes Cursor Invisable.  }
  614. {    SET_CURSOR(UNDERLINE);     Makes Normal Cursor.     }
  615. {    SET_CURSOR(BLOCK);         Makes Block Cursor.      }
  616. {    SET_CURSOR(HALF);          Makes a Half Cursor.     }
  617. (*════════════════════════════════════════════════════════════════════════*)
  618. PROCEDURE SHOW_VERSION;
  619.  
  620. {           Displays a Window and the contents of the         }
  621. {           global variable    VERSION.                       }
  622. (*════════════════════════════════════════════════════════════════════════*)
  623. FUNCTION  SPACES(NUM : Word) : STRING;
  624.  
  625. {            S := SPACES(25);         Will Initialize the variable S   }
  626. {                                     to 25 spaces.                    }
  627. (*════════════════════════════════════════════════════════════════════════*)
  628. PROCEDURE START_TIMER(VAR T : LONGINT);
  629.  
  630. {           START_TIMER(TIM);         Will Start a timer by setting the }
  631. {                                     value of TIM (or any LONGINT) to  }
  632. {                                     a time related value.             }
  633. {                                     By calling ELAP_TIME with this    }
  634. {                                     same variable, you can tell how   }
  635. {                                     many seconds has elapsed.         }
  636. {                                     This routine works accurately     }
  637. {                                     for over 30 years.                }
  638. (*════════════════════════════════════════════════════════════════════════*)
  639. PROCEDURE UN_ENCRYPT(VAR LINE : STRING; I : INTEGER);
  640.  
  641. {                                     UN-ENCRYPTS A STRING USING I AS KEY.}
  642.  
  643. (*════════════════════════════════════════════════════════════════════════*)
  644. FUNCTION  UPPERCASE(S : STRING) : STRING;
  645.  
  646. {            S := UPPERCASE(S);       Will Uppercase all Lowercase    }
  647. {                                     characters in the string S.     }
  648. (*════════════════════════════════════════════════════════════════════════*)
  649. PROCEDURE UP_SOUND;
  650.  
  651. {           Makes a Sound of Increasing Pitch.                }
  652. (*════════════════════════════════════════════════════════════════════════*)
  653. FUNCTION  WHOAMI : STRING;
  654.  
  655. {          S := WHOAMI;               Returns the complete Drive & }
  656. {                                     Pathname & Filename of the   }
  657. {       C:\TEST\FILENAME.EXE          program being executed.      }
  658. (*════════════════════════════════════════════════════════════════════════*)
  659. PROCEDURE WRITE_DATE(X, Y : INTEGER; WORDS    : CHAR);
  660.  
  661. {           WRITE_DATE(X,Y,'W');      Will display the current  }
  662. {                                     date in words at screen   }
  663. {                                     location X,Y.             }
  664. {       March 2, 1988                                           }
  665. {       03/02/88                      Any character except W    }
  666. {                                     will display it in        }
  667. {                                     03/02/88 format.          }
  668. (*════════════════════════════════════════════════════════════════════════*)
  669. PROCEDURE WRITE_TIME(X, Y : INTEGER; MILITARY : CHAR);
  670.  
  671. {           WRITE_TIME(X,Y,'M');      Will display the current   }
  672. {                                     time in Military Format    }
  673. {             14:52                   at screen location  X,Y.   }
  674. {              2:52 pm                                           }
  675. {                                     Any Character Except M     }
  676. {                                     will display time in AM/PM.}
  677. {                                     The Colon Will Flash.      }
  678. (*════════════════════════════════════════════════════════════════════════*)
  679. PROCEDURE WRITE_X80_Y25(CH : CHAR; ATTRIB : INTEGER);
  680.  
  681. (*                                     Writes CH at Column 80 on Line 25
  682.                                        in the Colors of ATTRIB without
  683.                                        scrolling.                         *)
  684. (*════════════════════════════════════════════════════════════════════════*)
  685. FUNCTION _REAL(INSTRING : STRING) : REAL;
  686.  
  687. {                                     Returns a REAL value from string.   }
  688. (*════════════════════════════════════════════════════════════════════════*)
  689. FUNCTION _INTEGER(INSTRING : STRING) : INTEGER;
  690.  
  691. {                                     Returns an INTEGER value from string.}
  692. (*════════════════════════════════════════════════════════════════════════*)
  693. FUNCTION _LONGINT(INSTRING : STRING) : LONGINT;
  694.  
  695. {                                     Returns a LONGINT from a string.     }
  696. (*════════════════════════════════════════════════════════════════════════*)
  697.  
  698.  
  699.  
  700.  
  701.